;
; Copyright (C) 2024 The Goldfish Scheme Authors
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
; http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
; License for the specific language governing permissions and limitations
; under the License.
;

(define-library (srfi srfi-151)
  (import (liii base))
  (export
    bitwise-not bitwise-and bitwise-ior bitwise-xor bitwise-eqv bitwise-nor bitwise-nand 
    bit-count bitwise-orc1 bitwise-orc2 bitwise-andc1 bitwise-andc2
    arithmetic-shift integer-length bitwise-if
    bit-set? copy-bit bit-swap any-bit-set? every-bit-set? first-set-bit
    bit-field bit-field-any? bit-field-every? bit-field-clear bit-field-set
    )
  (begin

    (define bitwise-not lognot)

    (define bitwise-and logand)

    (define bitwise-ior logior)

    (define bitwise-xor logxor)

    (define (bitwise-eqv a b)
            (= (bitwise-xor a b) 0))

    (define (bitwise-nor a b)  
            (lognot (bitwise-ior a b)))

    (define (bitwise-nand a b)  
            (lognot (bitwise-and a b)))

    (define bit-count 
      (typed-lambda ((i integer?))
        (define (bit-count-positive i)
          (let loop ((n i) (cnt 0))
            (if (= n 0)
                cnt
                (loop (logand n (- n 1)) (+ cnt 1)))))

        (cond ((zero? i) 0)
              ((positive? i) (bit-count-positive i))
              (else (bit-count-positive (lognot i))))))

    (define (bitwise-orc1 i j)
      (bitwise-ior (bitwise-not i) j))

    (define (bitwise-orc2  i j) 
      (bitwise-ior i (bitwise-not j)))

    (define (bitwise-andc1 i j)  
      (bitwise-and (bitwise-not i) j))

    (define (bitwise-andc2 i j) 
      (bitwise-and i (bitwise-not j)))

    (define arithmetic-shift ash)

    (define (integer-length n)
      (if (zero? n)
          0
          (let loop ((value (abs n)) (count 1))
               (if (<= value 1)
                   count
                   (loop (ash value -1) (+ count 1))))))

    (define (bitwise-if mask a b)
      (bitwise-ior
       (bitwise-and mask a)
       (bitwise-and (bitwise-not mask) b)))

    (define (bit-set? index n)
      (cond
        ((negative? index)
         (error 'out-of-range "bit-set?: Index cannot be negative" index))
        ((> index 63)
         (error 'out-of-range "bit-set?: Index cannot exceed 63" index))
        ((= index 63)
         (negative? n))
        (else
         (not (zero? (bitwise-and n (arithmetic-shift 1 index)))))))

    (define (copy-bit index n boolean)
      (cond
        ((negative? index)
         (error 'out-of-range "copy-bit: Index cannot be negative" index))
        ((> index 63)
         (error 'out-of-range "copy-bit: Index cannot exceed 63" index))
        ((= index 63)
         (if boolean
             (bitwise-ior n #x8000000000000000)
             (bitwise-and n #x7FFFFFFFFFFFFFFF)))
        (else
         (if boolean
             (bitwise-ior n (arithmetic-shift 1 index))
             (bitwise-and n (bitwise-not (arithmetic-shift 1 index)))))))

    (define (bit-swap index1 index2 n)
     (cond
      ((or (negative? index1) (negative? index2))
       (error 'out-of-range "bit-swap: Index cannot be negative" index1 index2))
      ((or (> index1 63) (> index2 63))
       (error 'out-of-range "bit-swap: Index cannot exceed 63" index1 index2))
      (else 
       (copy-bit index2
         (copy-bit index1 n (bit-set? index2 n))
         (bit-set? index1 n)))))

    (define (any-bit-set? test-bits n)
      (not (zero? (bitwise-and test-bits n))))

    (define (every-bit-set? test-bits n)
      (= (bitwise-and test-bits n) test-bits))

    (define (first-set-bit n)
      (if (zero? n)
          -1
          (let ((lsb (bitwise-and n (- n))))
            (- (integer-length lsb) 1))))

    (define (bit-field i start end)
      (let* ((bits (integer-length i)))
        (if (>= start bits)
            (error 'out-of-range "bit-field: Start cannot be greater than or equal to the integer length" start)
            (let* ((end (min end bits))
                   (width (- end start)))
              (if (<= width 0)
                  0
                  (let ((mask (arithmetic-shift (- (expt 2 width) 1) start)))
                    (arithmetic-shift (bitwise-and i mask) (- start))))))))

    (define (bit-field-any? i start end)
      (not (zero?
             (bitwise-and
               (arithmetic-shift i (- start))
               (- (arithmetic-shift 1 (- end start)) 1)))))

    (define (bit-field-every? i start end)
      (= (bitwise-and (arithmetic-shift i (- start)) 
                      (- (arithmetic-shift 1 (- end start)) 1)) 
         (- (arithmetic-shift 1 (- end start)) 1)))

    (define (bit-field-clear i start end)
      (bitwise-and i
        (bitwise-not
          (arithmetic-shift
            (- (arithmetic-shift 1 (- end start)) 1) start))))

    (define (bit-field-set i start end)
      (bitwise-ior i
        (arithmetic-shift
          (- (arithmetic-shift 1 (- end start)) 1) start)))

    ) ; end of begin
  ) ; end of define-library

